home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / converter.bas < prev    next >
Encoding:
BASIC Source File  |  2005-03-31  |  3.0 KB  |  96 lines
  1. Attribute VB_Name = "modConverter"
  2. Global ObjApp As Application
  3. Global Drs As Drawings
  4. Global bConversionRunned As Boolean
  5. Global bInterupt As Boolean
  6. Global sCaption As String
  7. Global isSummInfo As Boolean
  8. 'Global Ftrs As Filters
  9. Global CurCombo As Boolean
  10. Global CurImportFilter As String
  11. Global CurExportFilter As String
  12. Global ArrayofExportFilterNames() As String
  13.  
  14. Declare Function AppGetCurrentApp Lib "DBAPI10.dll" () As Long
  15. Declare Function AppSetupFilter Lib "DBAPI10.dll" (ByVal hApp As Long, ByVal ReadWrite As Boolean, ByVal ext As String, ByVal descr As String) As Boolean
  16. Sub Main()
  17.  
  18. End Sub
  19. 'this function removes duplicates of IDS
  20. Public Function CorrectIDs(ByVal Dr As Drawing)
  21.     On Error GoTo E
  22.     Dim curSpaceMode As ImsiSpaceModeType
  23.     Dim Pss As PaperSpaces
  24.     Dim Ps As PaperSpace
  25.     curSpaceMode = Dr.Properties("TileMode")
  26.     'correct IDs for graphics in blocks table
  27.     Call correctBlockTableIDs(Dr.Blocks)
  28.     Set Pss = Dr.PaperSpaces
  29. ' correct IDs for graphics in PaperSpaces
  30.     For Each Ps In Pss
  31.         Call correctIDGraphic(Ps.Graphics)
  32.     Next
  33. ' correct IDs for graphics in Model spaces
  34.     Set Ps = Nothing
  35.     Set Pss = Nothing
  36.     If curSpaceMode = imsiModelSpace Then
  37.         Call correctIDGraphic(Dr.Graphics)
  38.     Else
  39.         Dr.Properties("TileMode") = imsiModelSpace
  40.         Call correctIDGraphic(Dr.Graphics)
  41.         Dr.Properties("TileMode") = curSpaceMode
  42.     End If
  43.     Exit Function
  44. E:
  45.     MsgBox LoadResString(116), vbOKOnly, "CorectIDS function failed! " & Err.Description
  46. End Function
  47.  
  48. Private Function correctIDGraphic(Grs As Graphics)
  49.     Dim g As Graphic
  50.     Dim g1 As Graphic
  51.     Dim gtmp As Graphic
  52.     Dim grsParent As Graphics
  53.     Dim id As Long
  54.     Dim id1 As Long
  55.     Dim Index As Long
  56.     
  57.     For Each g In Grs
  58.         id = g.id
  59.         g.Deleted = True
  60.         On Error Resume Next
  61.         Set g1 = Grs.GraphicFromID(id)
  62.         Err.Clear
  63.         If Not g1 Is Nothing Then ' And (g <> g1) Then 'Or g.Index <> g1.Index Then
  64.                 g.Deleted = False
  65.                 Set grsParent = g.Parent
  66.                 Index = g.Index
  67.                 Set g = grsParent.Remove(Index)
  68.                 g.id = 0
  69.                 If Index = 0 Then
  70.                     grsParent.AddGraphic g, 0
  71.                 ElseIf (Index = grsParent.Count) Then
  72.                     grsParent.AddGraphic g
  73.                 Else
  74.                     grsParent.AddGraphic g, Index
  75.                 End If
  76. '                If Index <> g.Index Then
  77. '                    MsgBox "ID is not changed"
  78. '                End If
  79.         End If
  80.         g.Deleted = False
  81.         If (g.TypeByValue = imsiGroup) Then
  82.             Call correctIDGraphic(g.Graphics)
  83.         End If
  84.         
  85.         Set g1 = Nothing
  86.         Set g = Nothing
  87.     Next
  88. End Function
  89. Private Function correctBlockTableIDs(Bks As Blocks)
  90.     Dim Bk As Block
  91.     For Each Bk In Bks
  92.         Call correctIDGraphic(Bk.Graphics)
  93.     Next
  94. End Function
  95.  
  96.